perm filename LOSS.LSP[TIM,LSP]6 blob
sn#754849 filedate 1984-05-14 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (declare (array* (notype primep 1))
C00006 ENDMK
Cā;
(declare (array* (notype primep 1))
(special answer)
(fixsw t))
(eval-when (eval load compile) (setq range 1000.))
(array primep t #.(1+ range))
(fillarray 'primep '(t))
(defun set-up ()
(do ((i 2 (1+ i)))
((> i #.range) t)
(cond ((primep i)
(do ((j (+ i i) (+ j i)))
((> j #.range) t)
(store (primep j) ()))))))
(defun list-of-primes ()
(do ((i 2 (1+ i))
(a ()))
((> i #.range) (nreverse a))
(cond ((primep i) (push i a)))))
;;; a b c
;;; d e f
;;; g h i
(defmacro neq (x . l)
(do ((l l (cdr l))
(a ()))
((null l) `(and ,@a))
(push `(not (= ,x ,(car l))) a)))
(defmacro is-prime (x)
`(and (> ,x 1)(< ,x #.(1+ range))(primep ,x)))
(defun find (l)
(do ((l (cdr l) (cdr l))
(a 0))
((null l) ())
(setq a (car l))
(do ((l (cdr l) (cdr l))
(b 0))
((null l) ())
(setq b (car l))
(do ((l (cdr l) (cdr l))
(c 0) (abctotal 0))
((null l) ())
(setq c (car l))
(setq abctotal (+ a b c))
(do ((l (cdr l) (cdr l))
(d 0) (g 0))
((null l) ())
(setq d (car l))
(setq g (- abctotal (+ a d)))
(cond ((and (is-prime g)
(= (+ b c)
(+ d g))
(neq g a b c d))
(do ((l (cdr l) (cdr l))
(e 0)(f 0)(h 0)(i 0))
((null l) t)
(setq e (car l))
(setq f (- abctotal (+ d e)))
(setq h (- abctotal (+ b e)))
(setq i (- abctotal (+ c f)))
(cond ((and
(neq f a b c d e)
(neq h a b c d e)
(neq i a b c d e)
(is-prime f)
(is-prime h)
(is-prime i)
(push
`((,a ,b ,c)
(,d ,e ,f)
(,g ,h ,i)) answer))))))))))))
(defun gogogo ()
(setq answer ())
(set-up)(find (list-of-primes)))
(defun add-3 (x)(+ (car x)(cadr x)(caddr x)))
(defun addcol (n l)
(+ (nth n (car l))(nth n (cadr l))(nth n (caddr l))))
(defun verify (l)
(let ((total (add-3 (car l))))
(and (= total (add-3 (cadr l)))(= total (add-3 (caddr l)))
(= total (addcol 0 l))(= total (addcol 1 l))(= total (addcol 2 l)))))
(include "timer.lsp[tim,lsp]")
(timer timit
(gogogo))